home *** CD-ROM | disk | FTP | other *** search
/ F1 Licenseware / F1 Licenseware - Volume 1.iso / disks / 049b.dms / 049b.adf / MORE_SOURCE_CODE / AJC-INSERT-DISK-2.AMOS / AJC-INSERT-DISK-2.amosSourceCode
AMOS Source Code  |  1992-02-26  |  2KB  |  117 lines
  1. '
  2. '  "PLEASE INSERT DISK 2"  
  3. '  And rather nice it is too.
  4. '
  5. '  Enjoy this routine, it's free 
  6. '  By AJC Ninety Three.  
  7. '  
  8. ' (cue large yawns)
  9. '
  10. ID2
  11. Edit 
  12.  
  13. Procedure ID2
  14.  
  15. Default Palette 0,$FFF
  16. Hide On 
  17. '
  18. Screen Open 3,320,9,2,Lowres
  19. Screen Display 3,,240,,
  20. Curs Off : Flash Off : Hide On 
  21. Pen 1 : Paper 0 : Colour 1,$FFF
  22. Centre "PLEASE INSERT DISK 2"
  23. Screen Open 1,320,200,2,Lowres
  24. Screen Open 0,320,40,2,Lowres
  25. Curs Off : Flash Off : Cls 0
  26. Screen 1
  27. Paper 0 : Pen 1
  28. Double Buffer 
  29. Autoback 0
  30. Screen Swap 
  31. Screen To Front 3
  32.  
  33. NPS=19
  34.  
  35. Curs Off : Paper 0 : Cls 
  36. Dim X#(NPS),Y#(NPS),Z#(NPS)
  37. XIDGIN#=200 : YRIGIN#=100
  38. ZEDSCALE#=0.003
  39.  
  40. XPOSITION#=-70 : YPOSITION#=0 : ZPOSITION#=150
  41. For I=1 To NPS
  42.    Read X#(I),Y#(I),Z#(I)
  43. Next I
  44.  
  45. Data -7,7,0,7,7,0,7,-7,0,-7,-7,0,-7,7,0
  46. Data -6,7,0,-6,0,0,6,0,0,6,7,0,7,7,0
  47. Data 7,-7,0,4,-7,0,4,-2,0,-4,-2,0,-4,-7,0
  48. Data 0,-7,0,0,-4,0,-2,-4,0,-2,-7,0
  49.  
  50. Gosub DDRAWBODY
  51.  
  52. DDEGREE#=5.25
  53. RRADIAN#=DDEGREE#*2*Pi#/360
  54. HELLISH=0
  55.  
  56. Do 
  57.    If Mouse Key : Pop Proc : End If 
  58.    Inc HELLISH
  59.    Gosub SPIN
  60.    If ZPOSITION#>60 Then ZPOSITION#=ZPOSITION#-2
  61.    XPOSITION#=28
  62.    YPOSITION#=20
  63.    Cls 
  64.    Gosub DDRAWBODY
  65. Loop 
  66. '
  67. '
  68. Cls 
  69. Gosub DDRAWBODY
  70. SPIN:
  71. K$=Inkey$
  72. For I=1 To NPS
  73.  K$=Upper$(K$)
  74.  If ZPOSITION#>60 Then ZPOSITION#=ZPOSITION#-1
  75.  If ZPOSITION#<160 Then ZPOSITION#=ZPOSITION#+1
  76. If HELLISH>40
  77.  Gosub TURN
  78.  Gosub TURN2
  79. End If 
  80.  Clear Key 
  81. Next I
  82. Return 
  83. '
  84. TURN:
  85. C#=X#(I)*Cos(RRADIAN#)-Y#(I)*Sin(RRADIAN#)
  86. Y#(I)=X#(I)*Sin(RRADIAN#)+Y#(I)*Cos(RRADIAN#)
  87. X#(I)=C#
  88. Return 
  89. '
  90. TURN2:
  91. C#=Y#(I)*Cos(RRADIAN#)-Z#(I)*Sin(RRADIAN#)
  92. Z#(I)=Y#(I)*Sin(RRADIAN#)+Z#(I)*Cos(RRADIAN#)
  93. Y#(I)=C#
  94. Return 
  95. '
  96. DDRAWBODY:
  97. XABSOLX#=X#(1)+XPOSITION# : YABSOLX#=Y#(1)+YPOSITION# : ZABSOLX#=Z#(1)+ZPOSITION#
  98. Gosub PERSPECTIVE
  99. XOLD#=XSCR# : YOLD#=YSCR#
  100. For I=2 To NPS
  101.    XABSOLX#=X#(I)+XPOSITION# : YABSOLX#=Y#(I)+YPOSITION# : ZABSOLX#=Z#(I)+ZPOSITION#
  102.    Gosub PERSPECTIVE
  103.    Draw XOLD#,YOLD# To XSCR#,YSCR#
  104.    XOLD#=XSCR# : YOLD#=YSCR#
  105. Next I
  106. Screen Swap 
  107. Wait Vbl 
  108. Return 
  109. '
  110. PERSPECTIVE:
  111. XSCR#=XABSOLX#/(ZABSOLX#*ZEDSCALE#)
  112. YSCR#=YABSOLX#/(ZABSOLX#*ZEDSCALE#)
  113. XSCR#=XSCR#
  114. YSCR#=YSCR#
  115. Return 
  116.  
  117. End Proc